home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 4.00 Begin VB.Form BezierForm Caption = "Bezier Curve" ClientHeight = 5490 ClientLeft = 2175 ClientTop = 930 ClientWidth = 4830 Height = 6180 Left = 2115 LinkTopic = "Form1" ScaleHeight = 366 ScaleMode = 3 'Pixel ScaleWidth = 322 Top = 300 Width = 4950 Begin VB.CommandButton CmdGo Caption = "Go" Height = 375 Left = 4320 TabIndex = 4 Top = 0 Width = 495 End Begin VB.CheckBox ControlCheck Caption = "Show Control Points" Height = 255 Left = 1080 TabIndex = 3 Top = 60 Value = 1 'Checked Width = 1815 End Begin VB.TextBox DtText Height = 285 Left = 240 TabIndex = 2 Text = "0.01" Top = 45 Width = 615 End Begin VB.PictureBox Canvas AutoRedraw = -1 'True Height = 4815 Left = 0 ScaleHeight = 317 ScaleMode = 3 'Pixel ScaleWidth = 317 TabIndex = 0 Top = 480 Width = 4815 End Begin VB.Label Label1 Caption = "dt" Height = 255 Index = 1 Left = 0 TabIndex = 1 Top = 60 Width = 255 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileExit Caption = "E&xit" End End Attribute VB_Name = "BezierForm" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit Const PI = 3.14159 Const GAP = 3 ' The endpoints are points 1 and 4. The control ' points are points 2 and 3. Const NumPts = 4 Dim PtX(1 To NumPts) As Single Dim PtY(1 To NumPts) As Single ' The index of the point being dragged. Dim Dragging As Integer Dim OldMode As Integer ' The Bezier curve parameters. Dim Ax As Single Dim Bx As Single Dim Cx As Single Dim Dx As Single Dim Ay As Single Dim By As Single Dim Cy As Single Dim Dy As Single ' ************************************************ ' Draw the curve on the indicated picture box. ' ************************************************ Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, dt As Single) Dim x1 As Single Dim y1 As Single Dim t As Single x1 = X(start_t) y1 = Y(start_t) pic.Cls pic.CurrentX = x1 pic.CurrentY = y1 t = start_t + dt Do While t < stop_t x1 = X(t) y1 = Y(t) pic.Line -(x1, y1) t = t + dt Loop x1 = X(stop_t) y1 = Y(stop_t) pic.Line -(x1, y1) End Sub ' ************************************************ ' Compute the Bezier curve parameters. ' ************************************************ Sub GetBezierValues(ex1 As Single, ey1 As Single, ex2 As Single, ey2 As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single, Ax As Single, Bx As Single, Cx As Single, Dx As Single, Ay As Single, By As Single, Cy As Single, Dy As Single) Ax = ex2 - ex1 - 3 * x2 + 3 * x1 Bx = 3 * ex1 - 6 * x1 + 3 * x2 Cx = -3 * ex1 + 3 * x1 Dx = ex1 Ay = ey2 - ey1 - 3 * y2 + 3 * y1 By = 3 * ey1 - 6 * y1 + 3 * y2 Cy = -3 * ey1 + 3 * y1 Dy = ey1 End Sub ' ************************************************ ' The parametric function Y(t). ' ************************************************ Function Y(t As Single) As Single Y = Ay * t ^ 3 + By * t * t + Cy * t + Dy End Function ' ************************************************ ' The parametric function X(t). ' ************************************************ Function X(t As Single) As Single X = Ax * t ^ 3 + Bx * t * t + Cx * t + Dx End Function ' ************************************************ ' Prepare to draw the Bezier curve. ' ************************************************ Private Sub DrawBezier() Const DOTTED = 2 Dim dt As Single Dim i As Integer ' Compute the curve parameters. GetBezierValues _ PtX(1), PtY(1), _ PtX(4), PtY(4), _ PtX(2), PtY(2), _ PtX(3), PtY(3), _ Ax, Bx, Cx, Dx, Ay, By, Cy, Dy ' Draw the curve. dt = CSng(DtText.Text) DrawCurve Canvas, 0, 1, dt If ControlCheck.Value = vbChecked Then ' Draw the control points. For i = 1 To NumPts Canvas.Line _ (PtX(i) - GAP, PtY(i) - GAP)- _ Step(2 * GAP, 2 * GAP), , BF Next i ' Connect the control points. OldMode = Canvas.DrawStyle Canvas.DrawStyle = DOTTED Canvas.CurrentX = PtX(1) Canvas.CurrentY = PtY(1) For i = 2 To NumPts Canvas.Line -(PtX(i), PtY(i)) Next i Canvas.DrawStyle = OldMode End If End Sub ' ************************************************ ' Select a point and start dragging it. ' ************************************************ Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim i As Integer ' Find a close point. For i = 1 To NumPts If Abs(PtX(i) - X) <= GAP And _ Abs(PtY(i) - Y) <= GAP Then Exit For Next i If i > NumPts Then Exit Sub Dragging = i OldMode = Canvas.DrawMode Canvas.DrawMode = vbInvert PtX(Dragging) = X PtY(Dragging) = Y Canvas.Line _ (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _ Step(2 * GAP, 2 * GAP), , BF End Sub ' ************************************************ ' Continue dragging a point. ' ************************************************ Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Dragging < 1 Then Exit Sub Canvas.Line _ (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _ Step(2 * GAP, 2 * GAP), , BF PtX(Dragging) = X PtY(Dragging) = Y Canvas.Line _ (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _ Step(2 * GAP, 2 * GAP), , BF End Sub ' ************************************************ ' Finish the drag and redraw the curve. ' ************************************************ Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Dragging < 1 Then Exit Sub Canvas.DrawMode = OldMode PtX(Dragging) = X PtY(Dragging) = Y Dragging = 0 DrawBezier End Sub Private Sub CmdGo_Click() DrawBezier End Sub Private Sub ControlCheck_Click() DrawBezier End Sub Private Sub Form_Load() PtX(1) = 0.4 * Canvas.ScaleWidth PtX(2) = 0.1 * Canvas.ScaleWidth PtX(3) = 0.8 * Canvas.ScaleWidth PtX(4) = 0.6 * Canvas.ScaleWidth PtY(1) = 0.8 * Canvas.ScaleHeight PtY(2) = 0.3 * Canvas.ScaleHeight PtY(3) = 0.2 * Canvas.ScaleHeight PtY(4) = 0.7 * Canvas.ScaleHeight End Sub ' ************************************************ ' Make the canvas as big as possible. ' ************************************************ Private Sub Form_Resize() Canvas.Move 0, Canvas.Top, _ ScaleWidth, ScaleHeight - Canvas.Top DrawBezier End Sub Private Sub mnuFileExit_Click() Unload Me End Sub